home *** CD-ROM | disk | FTP | other *** search
/ Shareware Super Platinum 8 / Shareware Super Platinum 8.iso / mac / PROGTOOL / DDPLUS63.ZIP;1 / DDANSI2.PAS < prev    next >
Encoding:
Pascal/Delphi Source File  |  1993-10-14  |  8.4 KB  |  282 lines
  1. unit ddansi2;
  2.  
  3. interface
  4.  
  5. uses dos, crt;
  6. {----------------------------------------------------------------------------}
  7. {                       Ansi screen emulation routines                       }
  8. {                              By Scott Baker                                }
  9. {                        Revised By Derrick Parkhurst
  10. {----------------------------------------------------------------------------}
  11. {                                                                            }
  12. { Purpose: to execute ansi escape sequences locally. This includes changing  }
  13. {          color, moving the cursor, setting high/low intensity, setting     }
  14. {          blinking, and playing music.                                      }
  15. {                                                                            }
  16. { Remarks: These routines use a few global variables which are defined       }
  17. {          below. So far, only ESC m, J, f, C, and ^N are supported by these }
  18. {          routines. I hope to include more in the future.                   }
  19. {                                                                            }
  20. { Routines: Here is a listing of the subroutines:                            }
  21. {                                                                            }
  22. {             change_color(x):      Change to ansi color code X.             }
  23. {             Eval_string(s):       Evaluate/execute ansi string             }
  24. {             ansi_write(ch):       Write a character with ansi checking     }
  25. {                                                                            }
  26. {----------------------------------------------------------------------------}
  27.  
  28. var
  29.  escape,blink,high,norm,any,any2,fflag,gflag: boolean;
  30.  ansi_string: string;
  31. const
  32.  ddansibanner: boolean = true;
  33.  
  34. procedure ansi_write(ch: char);
  35. procedure ansi_write_str(var s: string);
  36. procedure initddansi;
  37.  
  38. implementation
  39.  
  40. const
  41.  scale: array[0..7] of integer = (0,4,2,6,1,5,3,7);
  42.  scaleh: array[0..7] of integer = (8,12,10,14,9,13,11,15);
  43. var
  44.  bbb: boolean;
  45.  t: char;
  46.  restx,resty,curcolor: integer;
  47.  Note_Octave: integer;
  48.  Note_Fraction, Note_Length, Note_Quarter: real;
  49.  
  50. procedure change_color(c: integer);
  51. begin;
  52.  case c of
  53.   00: begin;any:=true;blink:=false;high:=false;norm:=true;end;
  54.   01: begin;high:=true;end;
  55.   02: begin;clrscr;any:=true;end;
  56.   05: begin;blink:=true;any:=true;end;
  57.  end;
  58.  if (c>29) and (c<38) then begin;
  59.   any:=true;
  60.   any2:=true;
  61.   c:=c-30;
  62.   curcolor:=c;
  63.   if (high=true) and (blink=true) then textcolor(scaleh[c]+128);
  64.   if (high=true) and (blink=false) then textcolor(scaleh[c]);
  65.   if (high=false) and (blink=true) then textcolor(scale[c]+128);
  66.   if (high=false) and (blink=false) then textcolor(scale[c]);
  67.   fflag:=true;
  68.  end;
  69.  if (c>39) and (c<48) then begin;
  70.   any:=true;
  71.   c:=c-40;
  72.   textbackground(scale[c]);
  73.   gflag:=true;
  74.  end;
  75. end;
  76.  
  77. procedure eval_string(var s: string);
  78. var
  79.  cp: integer;
  80.  T: CHAR;
  81.  jj,tt,ttt,tttt: integer;
  82.  flag1:boolean;
  83. begin;
  84.  t:=s[length(s)];
  85.  cp:=2;
  86.  case t of
  87.   'k','K': clreol;
  88.   'u': gotoxy(restx,resty);
  89.   's': begin;
  90.         restx:=wherex;
  91.         resty:=wherey;
  92.        end;
  93.   'm','J':begin;
  94.            repeat;
  95.             tt:=-1;
  96.             val(s[cp],tt,tttt);
  97.             if tttt=0 then begin;
  98.              cp:=cp+1;
  99.              val(s[cp],ttt,tttt);
  100.              if tttt=0 then begin;
  101.               tt:=tt*10;
  102.               tt:=tt+ttt;
  103.              end;
  104.              change_color(tt);
  105.             end;
  106.             cp:=cp+1;
  107.            until cp>=length(s);
  108.            if norm=true then begin;
  109.              if (fflag=false) and (gflag=false) then begin;textcolor(7);textbackground(0);curcolor:=7;end;
  110.              if (fflag=false) and (gflag=true) then begin;textcolor(7);curcolor:=7;end;
  111.              if (high=true) and (fflag=false) then textcolor(scaleh[curcolor]);
  112.              if (blink=true) and (fflag=false) then textcolor(scale[curcolor]+128);
  113.              if (blink=true) and (high=true) and (fflag=false) then textcolor(scaleh[curcolor]+128);
  114.              if (fflag=true) and (gflag=false) then begin;textbackground(0);end;
  115.             end;
  116.            if any=false then textcolor(scaleh[curcolor]);
  117.            if (high=true) and (any2=false) then textcolor(scaleh[curcolor]);
  118.            any2:=false;any:=false;fflag:=false;gflag:=false;norm:=false;
  119.          end;
  120.    'C': begin;
  121.             tt:=1;
  122.             val(s[cp],tt,tttt);
  123.             if tttt=0 then begin;
  124.              cp:=cp+1;
  125.              val(s[cp],ttt,tttt);
  126.              if tttt=0 then begin;
  127.               tt:=tt*10;
  128.               tt:=tt+ttt;
  129.              end;
  130.             end else tt:=1;
  131.             ttt:=wherex;
  132.             if tt+ttt<=80 then gotoxy(tt+ttt,wherey);
  133.            end;
  134.    'D': begin;
  135.             tt:=1;
  136.             val(s[cp],tt,tttt);
  137.             if tttt=0 then begin;
  138.              cp:=cp+1;
  139.              val(s[cp],ttt,tttt);
  140.              if tttt=0 then begin;
  141.               tt:=tt*10;
  142.               tt:=tt+ttt;
  143.              end;
  144.             end else tt:=1;
  145.             ttt:=wherex;
  146.             if ttt-tt>=1 then gotoxy(ttt-tt,wherey);
  147.            end;
  148.    'A': begin;
  149.             tt:=1;
  150.             val(s[cp],tt,tttt);
  151.             if tttt=0 then begin;
  152.              cp:=cp+1;
  153.              val(s[cp],ttt,tttt);
  154.              if tttt=0 then begin;
  155.               tt:=tt*10;
  156.               tt:=tt+ttt;
  157.              end;
  158.             end else tt:=1;
  159.             ttt:=wherey;
  160.             if ttt-tt>=1 then gotoxy(wherex,ttt-tt);
  161.            end;
  162.    'B': begin;
  163.             tt:=1;
  164.             val(s[cp],tt,tttt);
  165.             if tttt=0 then begin;
  166.              cp:=cp+1;
  167.              val(s[cp],ttt,tttt);
  168.              if tttt=0 then begin;
  169.               tt:=tt*10;
  170.               tt:=tt+ttt;
  171.              end;
  172.             end else tt:=1;
  173.             ttt:=wherey;
  174.             if ttt+tt<=25 then gotoxy(wherex,ttt+tt);
  175.            end;
  176.   'f','H': begin;
  177.            flag1:=false;
  178.            tt:=1;
  179.             val(s[cp],tt,tttt);
  180.             if tttt=0 then begin;
  181.              cp:=cp+1;
  182.              val(s[cp],ttt,tttt);
  183.              if tttt=0 then begin;
  184.               tt:=tt*10;
  185.               tt:=tt+ttt;
  186.               flag1:=true;
  187.              end;
  188.             end else tt:=1;
  189.             jj:=tt;
  190.             if flag1=false then cp:=cp+1;
  191.             if flag1=true then cp:=cp+2;
  192.             if cp<length(s) then begin;
  193.             tt:=1;
  194.             val(s[cp],tt,tttt);
  195.             if tttt=0 then begin;
  196.              cp:=cp+1;
  197.              val(s[cp],ttt,tttt);
  198.              if tttt=0 then begin;
  199.               tt:=tt*10;
  200.               tt:=tt+ttt;
  201.              end;
  202.             end else tt:=1;
  203.            end else tt:=1;
  204.           gotoxy(tt,jj);
  205.        end;
  206.   else writeln(s);
  207.  end;
  208. end;
  209.  
  210. Procedure ansi_write(ch: char);
  211. begin;
  212.   case ch of
  213.    #12: clrscr;
  214.    #09: repeat; write(' '); until wherex/8 = wherex div 8;
  215.    #27: begin; escape:=true; bbb:=true; end;
  216.  
  217.    else begin;
  218.     if escape then begin;
  219.      if (bbb=true) and (ch<>'[') then begin;
  220.       blink:=false;
  221.       high:=false;
  222.       escape:=false;
  223.       ansi_string:='';
  224.       write(#27);
  225.      end else bbb:=false;
  226.      if escape then begin;
  227.       ansi_string:=ansi_string+ch;
  228.       if ch=#13 then escape:=false;
  229.       if (ch in ['u','s','A','B','C','D','H','m','J','f','K','k',#14]) then begin;
  230.        escape:=false;
  231.        eval_string(ansi_string);
  232.        ansi_string:='';
  233.       end;
  234.      end;
  235.     end else write(ch);
  236.    end;
  237.   end;
  238. end;
  239.  
  240. Procedure ansi_write_str(var s: string);
  241. var
  242.  a: integer;
  243. begin;
  244.  for a:=1 to length(s) do begin;
  245.   case s[a] of
  246.    #12: clrscr;
  247.    #09: repeat; write(' '); until wherex/8 = wherex div 8;
  248.    #27: begin; escape:=true; bbb:=true; end;
  249.  
  250.    else begin;
  251.     if escape then begin;
  252.      if (bbb=true) and (s[a]<>'[') then begin;
  253.       blink:=false;
  254.       high:=false;
  255.       escape:=false;
  256.       ansi_string:='';
  257.       write(#27);
  258.      end else bbb:=false;
  259.      if escape then begin;
  260.       ansi_string:=ansi_string+s[a];
  261.       if s[a]=#13 then escape:=false;
  262.       if (s[a] in ['u','s','A','B','C','D','H','m','J','f','K','k',#14]) then begin;
  263.        escape:=false;
  264.        eval_string(ansi_string);
  265.        ansi_string:='';
  266.       end;
  267.      end;
  268.     end else write(s[a]);
  269.    end;
  270.   end;
  271.  end;
  272. end;
  273.  
  274. procedure InitDDAnsi;
  275. begin;
  276.  escape:=false;
  277.  ansi_string:='';
  278.  blink:=false;
  279.  high:=false;
  280. end;
  281.  
  282. end.